home *** CD-ROM | disk | FTP | other *** search
Text File | 1993-10-26 | 3.7 KB | 128 lines | [TEXT/MPS ] |
- #
- # process.test
- #
- # Tests for the fork, execl and wait commands.
- #---------------------------------------------------------------------------
- # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
- #
- # Permission to use, copy, modify, and distribute this software and its
- # documentation for any purpose and without fee is hereby granted, provided
- # that the above copyright notice appear in all copies. Karl Lehenbauer and
- # Mark Diekhans make no representations about the suitability of this
- # software for any purpose. It is provided "as is" without express or
- # implied warranty.
- #------------------------------------------------------------------------------
- # $Id: process.test,v 2.5 1993/08/03 06:50:36 markd Exp $
- #------------------------------------------------------------------------------
- #
-
- if {[info procs test] != "test"} then {source testlib.tcl}
-
- # Proc to fork and exec child that loops until it gets a signal. If pgroup
- # is set, a file is created to indicate its been done. This lets the
- # parent sync up with the child.
-
- proc ForkLoopingChild {{setPGroup 0}} {
- unlink -nocomplain {PGROUP.SET}
- flush stdout
- flush stderr
- set newPid [fork]
- if {$newPid != 0} {
- if $setPGroup {
- while {![file exists PGROUP.SET]} {
- sleep 1
- }
- }
- return $newPid
- }
- if $setPGroup {
- id process group set
- close [open PGROUP.SET w]
- }
- execl ../tclmaster/bin/tcl {-qc {catch {while {1} {sleep 1}}; exit 10}}
- error "Should never make it here"
- }
-
-
- # Test fork, execl, and wait commands.
-
- Test process-1.1 {fork, execl, wait tests} {
- set newPid [fork]
- if {$newPid == 0} {
- execl ../tclmaster/bin/tcl {-qc {sleep 1;exit 12}}
- error "Should never make it here"
- }
- lrange [wait $newPid] 1 end
- } 0 {EXIT 12}
-
- Test process-1.2 {fork, execl, wait tests} {
- set newPid [ForkLoopingChild]
- sleep 1
-
- kill $newPid
- lrange [wait $newPid] 1 end
- } 0 {SIG SIGTERM}
-
- set newPid1 [ForkLoopingChild]
- set newPid2 [ForkLoopingChild]
-
- Test process-1.3 {fork, execl, wait tests} {
- sleep 3 ;# Give em a chance to get going.
-
- kill [list $newPid1 $newPid2]
-
- list [wait $newPid1] [wait $newPid2]
-
- } 0 [list "$newPid1 SIG SIGTERM" "$newPid2 SIG SIGTERM"]
-
- Test process-1.4 {fork, execl, wait tests} {
- fork foo
- } 1 {wrong # args: fork}
-
- Test process-1.5 {fork, execl, wait tests} {
- wait baz
- } 1 {invalid pid or process group id "baz"}
-
- Test process-1.6 {fork, execl, wait tests} {
- set testPid [ForkLoopingChild]
- kill $testPid
- set result [wait $testPid]
- lrange $result 1 end
- } 0 {SIG SIGTERM}
-
- # Test extended wait functionality, if available.
-
- catch {wait -nohang 1} result
- if [string match "The \"-nohang\", \"-untraced\"*" $result] {
- echo *** Extended wait functionallity not available on this system"
- echo *** Skipping the remainder of the process tests"
- return
- }
-
- Test process-2.1 {fork, execl, wait tests} {
- set testPid [ForkLoopingChild]
- set result1 [wait -nohang $testPid]
- kill $testPid
- set result2 [wait $testPid]
- list $result1 [lrange $result2 1 end]
- } 0 {{} {SIG SIGTERM}}
-
- Test process-2.2 {fork, execl, wait tests} {
- set testPid [ForkLoopingChild 1]
- set result1 [wait -nohang -pgroup $testPid]
- kill $testPid
- set result2 [wait -pgroup $testPid]
- list $result1 [lrange $result2 1 end]
- } 0 {{} {SIG SIGTERM}}
-
- Test process-2.3 {fork, execl, wait tests} {
- set testPid [ForkLoopingChild 1]
- set result1 [wait -nohang -pgroup -untraced $testPid]
- kill $testPid
- set result2 [wait -pgroup -untraced $testPid]
- list $result1 [lrange $result2 1 end]
- } 0 {{} {SIG SIGTERM}}
-
-
- unlink -nocomplain {PGROUP.SET}
-